BMUG PD-ROM 1995 Fall/PD-ROM F95.toast/Utilities/Text Utils/BBEdit Modules ƒ/Make Reply ƒ/For scriptors⁄programmers/Make Reply.p

Text File | 1995-03-15 | 6.3 KB | 296 lines | [TEXT/PJMM]

unit Main;

{ modified from BBIMPORT }
{ ANTI© 1993 Merzwaren }

interface

    uses
        OSA, BBextIntf;

    procedure Main (callbacks: BBEditParmBlkPtr; w: WindowPtr);

implementation

    procedure Main (callbacks: BBEditParmBlkPtr; w: WindowPtr);
        var
            gSC: ComponentInstance;
            sID: OSAID;
            err: OSAError;
            selStart, selEnd, firstChar: longint;
            txt: Handle;
            Sender, Subject: str255;

        procedure Debug (Str: str255);
        begin
            BBInsert(@Str[1], length(Str), callbacks^.insertProc);    { for debugging }
        end;

        procedure DebugNum (Str: str255; N: longint);
            var
                S: str255;
        begin
            NumToString(N, S);
            Debug(concat(Str, ' *', S, '* '));
        end;

        procedure CleanUp;
        begin
            if gSC <> nil then
                begin
                    err := OSADispose(gSC, sID);
                    err := CloseComponent(gSC);
                end;
        end;  {CleanUp}

        procedure BeepAndExit;
        begin
            CleanUp;
            SysBeep(2);
            Exit(Main);
        end;  {BeepAndExit}

        procedure CheckError;
        begin
            if (err <> noErr) then
                begin
{DebugNum('Error', err);}
                    BBReportOSError(err, callbacks^.reportOSErrProc);
                    CleanUp;
                    Exit(Main);
                end;
        end;  {CheckError}

        procedure CheckNil (h: handle; n: integer);
        begin
            if (h = nil) then
                begin
                    BBReportOSError(n, callbacks^.reportOSErrProc);
                    CleanUp;
                    Exit(Main);
                end;
        end;  {CheckNil}


        procedure GetMailFields;
            var
                n: INTEGER;
                found: boolean;
                p1, p, v: longint;
                X, Y: str255;

            procedure SkipToCR;
            begin
                p1 := p;
                while (p < v) & (ptr(p)^ <> 13) do
                    p := p + 1;
                if (p < v) then
                    p := p + 1;
            end;

            procedure MakeString (start: longint; len: integer; var Str: str255);
            begin
{if len > 255 then len := 255;}
                BlockMove(ptr(start), @Str[1], len);
                Str[0] := chr(len);
            end;

            procedure FilterQuotes (var Str: str255);
                var
                    k: integer;
            begin
                for k := 1 to length(Str) do
                    if Str[k] = '"' then
                        Str[k] := chr(39);    {'}
            end;

        begin
            p := ord(txt^) + selStart;
            v := ord(txt^) + selEnd;
            SkipToCR;
            found := false;

            while (p1 < p) and not found do
                begin
                    n := p - p1 - 1;
                    if n > 255 then
                        n := 255;
                    MakeString(p1, 9, X);
                    MakeString(p1, 6, Y);

                    case X[1] of
                        'S':
                            if (Subject = '') & (X = 'Subject: ') then
                                begin
                                    MakeString(p1 + 9, n - 9, Subject);
                                    FilterQuotes(Subject);
                                    if (Sender <> '') then
                                        found := true;
                                end;
                        'F':
                            if (Sender = '') & (Y = 'From: ') then
                                begin
                                    MakeString(p1 + 6, n - 6, Sender);
                                    FilterQuotes(Sender);
                                    if (Subject <> '') then
                                        found := true;
                                end;
                    end;
                    SkipToCR;
                end;
            Subject := concat('Re: ', Subject);
        end;

        procedure LoadScript (var ID: OSAID);
            var
                h: handle;
                data: AEDesc;
        begin
            ID := kOSANullScript;
            h := Get1Resource(kOSAScriptResourceType, 128);
            err := ResError;
            if (h <> nil) then
                begin
                    data.descriptorType := typeOSAGenericStorage;
                    data.dataHandle := h;
                    err := OSALoad(gSC, data, kOSAModeNull, ID);
                    ReleaseResource(data.dataHandle);
                end;
            CheckError;
        end;

        function SameContents (h1, h2: handle): boolean;
            var
                n1, n2, k: longint;
                p1, p2: ptr;
                same: boolean;
        begin
            n1 := GetHandleSize(h1);
            n2 := GetHandleSize(h2);
            same := (n1 = n2);
            p1 := h1^;
            p2 := h2^;
            k := 0;
            while same & (k < n1) do
                begin
                    if (p1^ <> p2^) then
                        same := false;
                    p1 := ptr(ord(p1) + 1);
                    p2 := ptr(ord(p2) + 1);
                    k := k + 1;
                end;
            SameContents := same
        end;

        procedure SaveScript (ID: OSAID);
            var
                h: handle;
                R: AEDesc;
        begin
            h := Get1Resource(kOSAScriptResourceType, 128);
            err := ResError;
            CheckError;
            if (h <> nil) then
                begin
                    err := OSAStore(gSC, ID, typeOSAGenericStorage, kOSAModeNull, R);
                    CheckError;
                    if SameContents(h, R.dataHandle) then
                        begin
                            ReleaseResource(h);
                            DisposHandle(R.dataHandle);
                        end
                    else
                        begin
                            RmveResource(h);
                            DisposHandle(h);
                            AddResource(R.dataHandle, kOSAScriptResourceType, 128, '');
                            WriteResource(R.dataHandle);
                            ReleaseResource(R.dataHandle);
                        end;
                end;
        end;

        procedure StringToHandle (Str: str255; h: handle);
        begin
            SetHandleSize(h, length(Str));
            if GetHandleSize(h) = length(Str) then
                BlockMove(@Str[1], h^, length(Str));
        end;

        procedure RunScript (ID: OSAID);
            const
                kASAppleScriptSuite = 'ascr';
                kASSubroutineEvent = 'psbr';
                keyASSubroutineName = 'snam';
            var
                res, D: AEDesc;
                List: AEDescList;
                AE: AppleEvent;
                rID: OSAID;
        begin
{ Create the event to send to the script }
            err := AECreateDesc(typeNull, nil, 0, D);
            err := AECreateAppleEvent(kASAppleScriptSuite, kASSubroutineEvent, D, kAutoGenerateReturnID, kAnyTransactionID, AE);
            CheckError;

{ Insert the subroutine event name }
            D.descriptorType := typeChar;
            D.dataHandle := BBAllocate(0, false, callbacks^.AllocateProc);
            StringToHandle('mail', D.dataHandle);
            err := AEPutParamDesc(AE, keyASSubroutineName, D);
            CheckError;

{ Make a list of positional parameters into the Direct Object }
            err := AECreateList(nil, 0, false, List);
            StringToHandle(Sender, D.dataHandle);
            err := AEPutDesc(List, 1, D);
            CheckError;
            StringToHandle(Subject, D.dataHandle);
            err := AEPutDesc(List, 2, D);
            CheckError;
            err := AEPutParamDesc(AE, keyDirectObject, List);
            CheckError;

{ Send the event to the script }
            err := OSAExecuteEvent(gSC, AE, ID, kOSAModeNull, rID);
            CheckError;
            err := AEDisposeDesc(AE);
            err := AEDisposeDesc(List);
            err := AEDisposeDesc(D);
            err := OSADispose(gSC, rID);
        end;

    begin
        if (w <> nil) & (WindowPeek(w)^.windowKind = userKind) then
            begin
{SetCursor(GetCursor(watchCursor)^^);}
                gSC := nil;

                txt := BBGetWindowContents(w, callbacks^.getWindowContentsProc);
                BBGetSelection(selStart, selEnd, firstChar, callbacks^.GetSelectionProc);
                if (selEnd = selStart) then
                    begin
                        selStart := 0;
                        selEnd := GetHandleSize(txt);
                    end;

                Subject := '';
                Sender := '';
                GetMailFields;
                if Sender = '' then
                    BeepAndExit;

                gSC := OpenDefaultComponent(kOSAComponentType, kOSAGenericScriptingComponentSubtype);
                if gSC = nil then
                    BeepAndExit;

                LoadScript(sID);
                SaveScript(sID);
                RunScript(sID);

                CleanUp;
{InitCursor;}
            end;
    end;

end.